home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Examples-2.01 / assorted-fred-commands.lisp next >
Encoding:
Text File  |  1993-09-16  |  19.3 KB  |  510 lines  |  [TEXT/CCL2]
  1. ;-*- Mode: Lisp; Package: CCL -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;assorted-fred-commands.lisp
  4. ;;copyright © 1990, Apple Computer, Inc.
  5. ;;
  6. ;;
  7. ;;  Examples of additional Fred commands.
  8. ;;
  9. ;;
  10.  
  11.  
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. ;;
  14. ;; Change History
  15. ;; 04/28/93 mwp Release
  16. ;; 03/19/93 bill (setf (buffer-getprop buf key) value) -> (buffer-putprop buf key value)
  17. ;; 02/23/93 bill ed-mpw-mode
  18. ;; 12/16/92 bill compile-file-for-buffer & friends now work correctly if
  19. ;;               the file name contains a "~" character.
  20. ;; 11/13/92 bill call frec functions that redraw with-focused-view.
  21. ;; 06/25/92 bill ed-delete-selection-silently
  22. ;; 06/02/92 bill clone-window uses its argument's class if it is a window.
  23. ;;-------------- 2.0
  24. ;; 01/06/92 bill add :shift in fred keystroke names where appropriate
  25. ;; 12/17/91 bill c-m-l -> c-m-L (c-m-l is ed-last-buffer)
  26. ;; ------------- 2.0b4
  27. ;; 08/28/91 gb   add an attribute line.
  28. ;; 08/28/91 bill c-m-. is ed-autoloading-edit-definition
  29. ;; 08/20/91 bill no more downward-function
  30. ;; 07/09/91 bill ed-fill-paragraph fills the first line of the paragraph
  31. ;; 05/30/91 bill c-m-C is compile-load-file-for-buffer
  32. ;;               c-m-l (small "L") is load-file-for-buffer
  33. ;;               c-m-B is ed-bold
  34. ;;               c-m-I (Capital "i") is ed-italic
  35. ;;               c-m-P is ed-plain
  36. ;; 05/16/91 bill It's not nice to bind a key to a function before it's been defined.
  37. ;;               prefix-numeric-value -> fred-prefix-numeric-value
  38. ;; 05/01/91 alice undo wants absolute buffer positions instead of marks, fred-prefix-numeric-value
  39. ;; 05/01/91 bill ed-scroll-up does a screenful if the shift key is not down.
  40. ;; 03/15/91 bill prefix-arg on TAB means indent region rigidly
  41. ;;               "C-x ." is ed-set-fill-prefix
  42. ;;               "C-x C-." is ed-set-fill-margin. The margin defaults
  43. ;;               to 72 pixels from the right edge of the view.
  44. ;;               "M-q" is ed-fill-paragraph
  45. ;; 02/27/91 bill Add buffer-remove-unsed-fonts to ed-refresh-screen.
  46. ;----------- 2.0b1
  47. ;; 01/24/91 bill m-n -> c-<shift>-V, m-p -> m-<shift>-V
  48. ;;               (scroll up or down one line)
  49. ;;
  50.  
  51. (in-package :ccl)
  52.  
  53. ; Commands to change the font.
  54. ; Change the insertion font if nothing is selected, or the selection otherwise.
  55. (defmethod ed-italic ((w fred-mixin))
  56.   (set-view-font w '(:italic)))
  57.  
  58. (defmethod ed-plain ((w fred-mixin))
  59.   (set-view-font w '(:plain)))
  60.  
  61. (defmethod ed-bold ((w fred-mixin))
  62.   (set-view-font w '(:bold)))
  63.  
  64. (comtab-set-key *comtab* '(:meta :control #\I) 'ed-italic)
  65. (comtab-set-key *comtab* '(:meta :control :shift #\P) 'ed-plain)
  66. (comtab-set-key *comtab* '(:meta :control :shift #\B) 'ed-bold)
  67.  
  68. ; M-N & M-P are similar to C-N & C-P, but the screen is moved, not the cursor.
  69. (defmethod ed-scroll-up ((w fred-mixin) &optional lines)
  70.   (if (shift-key-p)
  71.     (let ((frec (slot-value w 'frec)))
  72.       (with-focused-view w
  73.         (frec-vscroll frec (or lines (fred-prefix-numeric-value w))))
  74.       (setq *show-cursor-p* nil))
  75.     (if (and lines (< lines 0))
  76.       (ed-previous-screen w)
  77.       (ed-next-screen w))))
  78.  
  79. (defmethod ed-scroll-down ((w fred-mixin) &optional lines)
  80.   (ed-scroll-up w (- (or lines (fred-prefix-numeric-value w)))))
  81.  
  82. (comtab-set-key *comtab* '(:control :shift #\V) 'ed-scroll-up)
  83. (comtab-set-key *comtab* '(:meta :shift #\V) 'ed-scroll-down)
  84.  
  85. ; C-L refreshes the screen.
  86. (defmethod ed-scroll-cursor-to-top ((w fred-mixin))
  87.   (let* ((frec (frec w))
  88.          (bpos (buffer-position (fred-buffer w)))
  89.          (lines (frec-full-lines frec))
  90.          (context (next-screen-context-lines lines)))
  91.     (set-mark (fred-display-start-mark w)
  92.               (frec-screen-line-start frec bpos (- context)))
  93.     (with-focused-view w
  94.       (frec-draw-contents frec t))))
  95.  
  96. (defmethod ed-refresh-screen ((w fred-mixin))
  97.   (buffer-remove-unused-fonts (fred-buffer w))
  98.   (with-focused-view w
  99.     (frec-draw-contents (frec w) t)))
  100.  
  101. ; You may prefer ed-scroll-cursor-to-top to ed-refresh-screen here.
  102. (comtab-set-key *comtab* '(:control #\l) 'ed-refresh-screen)
  103.  
  104.  
  105. ; C-M-W toggles line wrapping.
  106. (defun ed-toggle-wrap-p (w)
  107.   (setf (fred-wrap-p w) (not (fred-wrap-p w)))
  108.   (ed-refresh-screen w))
  109.  
  110. (comtab-set-key *comtab* '(:control :meta #\w) 'ed-toggle-wrap-p)
  111.  
  112.  
  113. ; C-X O moves to the next window that is not a listener.
  114. ; C-X N moves the top window to the bottom.
  115. ; C-X P moves the bottom window to the top.
  116. (defmethod ed-other-window ((w fred-mixin))
  117.   (setq w (view-window w))
  118.   (if *modal-dialog-on-top*
  119.     (ed-beep)
  120.     (let ((other-window #'(lambda (window)
  121.                             (unless (or (eq w window) (typep window 'listener))
  122.                               (window-select window)
  123.                               (return-from ed-other-window window)))))
  124.       (declare (dynamic-extent other-window))
  125.       (map-windows other-window))))
  126.  
  127. (defmethod ed-next-window ((w fred-mixin))
  128.   (set-window-layer w 10000))
  129.  
  130. (defmethod ed-previous-window ((w fred-mixin))
  131.   (let ((last (car (last (windows)))))
  132.     (when last
  133.       (window-select last))))
  134.  
  135. (comtab-set-key *control-x-comtab* '(#\o) 'ed-other-window)
  136. (comtab-set-key *control-x-comtab* '(#\n) 'ed-next-window)
  137. (comtab-set-key *control-x-comtab* '(#\p) 'ed-previous-window)
  138.  
  139. ; <Shift><Tab> inserts a tab character in the buffer.
  140. ; <Prefix Argument><Tab> indents the region by <Prefix Argument> spaces
  141. ; (which must be positive)
  142.  
  143. (defmethod ed-tab ((w fred-mixin))
  144.   (if (shift-key-p)
  145.     (ed-self-insert w)
  146.     (let ((value (fred-prefix-argument w)))
  147.       (if value
  148.         (fred-indent-region-rigidly w value)
  149.         (ed-indent-for-lisp w)))))
  150.  
  151. ; This should really support undo.
  152. (defmethod fred-indent-region-rigidly ((w fred-mixin) &optional 
  153.                                        (value (fred-prefix-numeric-value w)))
  154.   (multiple-value-bind (b e) (kill-range w)
  155.     (if (< e b)
  156.       (psetq e b b e))
  157.     (if (= e b) (return-from fred-indent-region-rigidly nil))
  158.     (let* ((buf (fred-buffer w))
  159.            (start (buffer-line-start buf b))
  160.            (bmark (make-mark buf b t))
  161.            (emark (make-mark buf e))
  162.            (string (buffer-substring buf b e))
  163.            (style (buffer-get-style buf b e)))
  164.       (setq e (make-mark buf (1- e)))
  165.       (unwind-protect
  166.         (flet ((insert-indentation (buf value pos)
  167.                  (dotimes (i value)
  168.                    (buffer-insert buf #\space pos))))
  169.           (if (eql b start) (insert-indentation buf value b))
  170.           (loop
  171.             (setq b (buffer-forward-find-char buf #\newline b (buffer-position e)))
  172.             (unless b (return))
  173.             (unless (or (eq b (buffer-size buf)) (eql #\newline (buffer-char buf b)))
  174.               (insert-indentation buf value b))))
  175.         (setup-undo w #'(lambda ()
  176.                           (buffer-delete buf (buffer-position bmark) (buffer-position emark))
  177.                           (buffer-insert-with-style buf string style)
  178.                           (fred-update w)))))))
  179.  
  180. (comtab-set-key *comtab* '#\tab 'ed-tab)
  181.  
  182. (defmethod ed-set-fill-prefix ((w fred-mixin))
  183.   (let* ((buf (fred-buffer w))
  184.          (pos (buffer-position buf))
  185.          (start (buffer-line-start buf))
  186.          (prefix (unless (eql start pos)
  187.                    (cons (buffer-substring buf start pos)
  188.                          (buffer-get-style buf start pos)))))
  189.     (if prefix
  190.       (setf (view-get w 'fill-prefix) prefix)
  191.       (view-remprop w 'fill-prefix))))
  192.  
  193. (defmethod ed-set-fill-margin ((w fred-mixin))
  194.   (let* ((buf (fred-buffer w))
  195.          (pos (buffer-position buf))
  196.          (start (buffer-line-start buf))
  197.          (wid (buffer-string-width buf start pos)))
  198.     (setf (view-get w 'fill-margin) wid)))
  199.  
  200. (comtab-set-key *control-x-comtab* #\. 'ed-set-fill-prefix)
  201. (comtab-set-key *control-x-comtab* '(:control #\.) 'ed-set-fill-margin)
  202.  
  203. (defconstant *paragraph-marker*
  204. "
  205.  
  206. ")
  207.  
  208. (defconstant *wsp&cr* #.(let ((str (make-string 7)))
  209.                           (setf (schar str 0) #\Space)
  210.                           (setf (schar str 1) #\^I)
  211.                           (setf (schar str 2) #\^L)
  212.                           (setf (schar str 3) #\^@)
  213.                           (setf (schar str 4) #\^J)
  214.                           (setf (schar str 5) (code-char #xCA))
  215.                           (setf (schar str 6) #\newline)
  216.                           str))
  217.  
  218. (defmethod paragraph-bounds ((w fred-mixin))
  219.   (multiple-value-bind (b e) (selection-range w)
  220.     (when (eq b e)
  221.       (let* ((buf (fred-buffer w)))
  222.         (setq b (buffer-backward-find-char buf #\newline))
  223.         (if b
  224.           (loop
  225.             (if (<= b 0) (return))
  226.             (let ((b2 (buffer-backward-find-char buf #\newline b 0)))
  227.               (unless b2 (return (setq b 0)))
  228.               (unless (buffer-forward-find-not-char buf *wsp&cr* b2 b)
  229.                 (return (incf b)))
  230.               (setq b b2)))
  231.           (setq b 0))
  232.         (setq e (buffer-forward-find-char buf #\newline))
  233.         (if e
  234.           (loop
  235.             (if (>= e (buffer-size buf)) (return))
  236.             (let ((e2 (buffer-forward-find-char buf #\newline e)))
  237.               (unless e2 (return (setq e (buffer-size buf))))
  238.               (unless (buffer-forward-find-not-char buf *wsp&cr* e e2)
  239.                 (return (decf e)))
  240.               (setq e e2)))
  241.           (setq e (buffer-size buf)))))
  242.     (values b e)))
  243.  
  244. (defmethod ed-fill-paragraph ((w fred-mixin))
  245.   (multiple-value-bind (b e) (paragraph-bounds w)
  246.     (unless (eq b e)
  247.       (let* ((buf (fred-buffer w))
  248.              (margin (or (view-get w 'fill-margin) (- (point-h (view-size w)) 72)))
  249.              (prefix (view-get w 'fill-prefix))
  250.              (bmark (make-mark buf b t))
  251.              (emark (make-mark buf e))
  252.              (string (buffer-substring buf b e))
  253.              (style (buffer-get-style buf b e))
  254.              p last-word-end wsp-end done?)
  255.         (unwind-protect
  256.           (progn
  257.             (setq e (make-mark buf e))
  258.             (if (and (eql b (buffer-line-start buf b))
  259.                      (setq p (buffer-forward-find-not-char buf *wsp&cr* b e)))
  260.               (progn
  261.                 (buffer-delete buf b (decf p))
  262.                 (setq p b)
  263.                 (when prefix
  264.                   (buffer-insert-with-style buf (car prefix) (cdr prefix) b)
  265.                   (incf p (length (car prefix)))))
  266.               (setq p b))
  267.             (loop
  268.               (setq p (buffer-forward-find-char buf *wsp&cr* p e))
  269.               (if p 
  270.                 (progn
  271.                   (setq wsp-end (buffer-forward-find-not-char buf *wsp&cr* p e)
  272.                         p (1- p)
  273.                         wsp-end (if wsp-end (1- wsp-end) e))
  274.                   (buffer-delete buf p wsp-end)
  275.                   (buffer-insert buf " " p))
  276.                 (setq p (buffer-position e) wsp-end p done? t))
  277.               (if (> (buffer-string-width buf b p) margin)
  278.                 (progn
  279.                   (unless last-word-end
  280.                     (if done? (return))
  281.                     (setq last-word-end p))
  282.                   (buffer-delete buf last-word-end (1+ last-word-end))
  283.                   (buffer-insert buf #\newline last-word-end)
  284.                   (setq b (1+ last-word-end)
  285.                         p b)
  286.                   (if (>= p (buffer-position e)) (return))
  287.                   (when prefix
  288.                     (buffer-insert-with-style buf (car prefix) (cdr prefix) b)
  289.                     (incf p (length (car prefix))))
  290.                   (setq last-word-end nil))
  291.                 (progn
  292.                   (setq last-word-end p)
  293.                   (incf p)))
  294.               (if done? (return))))
  295.           (setup-undo w #'(lambda ()
  296.                             (buffer-delete bmark (buffer-position bmark) (buffer-position emark))
  297.                             (buffer-insert-with-style bmark string style)
  298.                             (fred-update w))))))))
  299.  
  300. (comtab-set-key *comtab* '(:meta #\q) 'ed-fill-paragraph)
  301.  
  302. ; C-X C-Y replaces the selection with a file.
  303. (comtab-set-key *control-x-comtab* '(:control #\y)
  304.                 'ed-replace-selection-with-chosen-file)
  305.  
  306. (defmethod ed-replace-selection-with-chosen-file ((w fred-mixin))
  307.    (let ((the-pathname
  308.           (catch-cancel (choose-file-dialog :button-string "File"))))
  309.       (unless (eql the-pathname :CANCEL)
  310.          (ed-kill-selection w)    ;If there is a selection, just kill it.
  311.          (let ((start-pos (buffer-position (fred-buffer w))))
  312.             (buffer-insert
  313.              (fred-buffer w)
  314.              (use-logical-dir (namestring the-pathname) '("ccl;" "home;")))
  315.             (set-selection-range w start-pos))))) ;select what was inserted
  316.  
  317. (defun use-logical-dir (the-namestring logical-dir-list
  318.                                        &aux dir-namestring)
  319.    "If the expansion of a given logical directory matches the prefix
  320.     of the pathname, a string is returned with the substitution made,
  321.     otherwise the original namestring is returned."
  322.    (dolist (a-logical-dir logical-dir-list)
  323.       (setq dir-namestring (namestring (full-pathname a-logical-dir)))
  324.       (if (eql (search dir-namestring the-namestring) 0)
  325.          (return-from
  326.           use-logical-dir
  327.           (concatenate
  328.            'simple-string
  329.            a-logical-dir
  330.            (subseq the-namestring (length dir-namestring))))))
  331.    the-namestring)
  332.  
  333. ; Disable the dead keys.
  334. ; You may not want to do this if you use accents a lot.
  335. (def-load-pointers disable-dead-keys ()
  336.   (set-dead-keys nil))
  337.  
  338.  
  339. ; C-M-C compiles the file for a fred-window.
  340. (defun compile-file-for-buffer (w)
  341.   (let ((file (pathname w)))
  342.     (if file
  343.       (let ((format-string "Compiling \"~a\"…~:[~; done.~]"))
  344.         (window-save w)
  345.         (set-mini-buffer w format-string file nil)
  346.         (fred-update w)
  347.         (eval-enqueue
  348.          `(progn
  349.             (compile-file ',file)
  350.             (set-mini-buffer ',w ,format-string ,file t))))
  351.       (ed-beep))))
  352.  
  353. (defun load-file-for-buffer (w)
  354.   (let ((file (pathname w)))
  355.     (if file
  356.       (progn
  357.         (setq file (make-pathname :type nil :defaults file))
  358.         (let ((format-string "Loading \"~a\"…~:[~; done.~]"))
  359.           (window-save w)
  360.           (set-mini-buffer w format-string file nil)
  361.           (fred-update w)
  362.           (eval-enqueue
  363.            `(progn
  364.               (load ',file)
  365.               (set-mini-buffer ',w ,format-string ,file t)))))
  366.       (ed-beep))))
  367.  
  368. (defun compile-load-file-for-buffer (w)
  369.   (let ((file (pathname w)))
  370.     (if file
  371.       (let ((format-string "Compiling & loading \"~a\"…~:[~; done.~]"))
  372.         (window-save w)
  373.         (set-mini-buffer w format-string file nil)
  374.         (fred-update w)
  375.         (eval-enqueue
  376.          `(progn
  377.             (compile-load ',file)
  378.             (set-mini-buffer ',w ,format-string ,file t))))
  379.       (ed-beep))))
  380.  
  381.  
  382. (comtab-set-key *comtab* '(:control :meta #\c) 'compile-file-for-buffer)
  383. (comtab-set-key *comtab* '(:control :meta :shift #\C) 'compile-load-file-for-buffer)
  384. (comtab-set-key *comtab* '(:control :meta :shift #\L) 'load-file-for-buffer)
  385.  
  386. ; C-M-Y makes a second copy of the top window sharing it's buffer.
  387. ; This still has a bug in that the modified markers are not updated in parallel.
  388. (defmethod clone-window ((view fred-mixin))
  389.   (let ((w (view-window view)))
  390.     (let ((new-w (make-instance (if (typep view 'window)
  391.                                   (class-of view)
  392.                                   *default-editor-class*)
  393.                                 :view-size (view-size w)
  394.                                 :view-position (add-points (view-position w) #@(15 15))
  395.                                 :buffer (make-mark (fred-buffer view))
  396.                                 :window-show nil))
  397.           (filename (pathname view)))
  398.       (when filename
  399.         (setf (slot-value new-w 'my-file-name) filename
  400.               (slot-value new-w 'file-modcnt) (slot-value view 'file-modcnt)
  401.               (fred-save-buffer-p w) t)
  402.         (set-window-title new-w (pathname-to-window-title filename)))
  403.       (set-mark (fred-display-start-mark new-w) 
  404.                 (buffer-position (fred-display-start-mark view)))
  405.       (window-show new-w))))
  406.  
  407. (comtab-set-key *comtab* '(:control :meta #\y) 'clone-window)
  408.  
  409. ; edit-definition, but look for unloaded interface definitions, too
  410. (defun autoloading-edit-definition (def)
  411.   (or (edit-definition def)
  412.       (let ((*autoload-traps* t)) 
  413.         (or (and (ignore-errors (load-trap def))
  414.                  (edit-definition def))
  415.             (and (load-record def)
  416.                  (edit-definition def))
  417.             (and (ignore-errors (load-trap-constant def))
  418.                  (edit-definition def))
  419.             (and (load-mactype def)
  420.                  (edit-definition def))))))
  421.  
  422. (defun ed-autoloading-edit-definition (w)
  423.   (let ((form (ignore-errors (ed-current-sexp w))))
  424.     (if (and form (symbolp form))
  425.       (autoloading-edit-definition form)
  426.       (ed-edit-definition w))))
  427.  
  428. (comtab-set-key *comtab* '(:control :meta #\.) 'ed-autoloading-edit-definition)
  429.  
  430. (defun ed-delete-selection-silently (self)
  431.   (multiple-value-bind (b e) (selection-range self)
  432.     (unless (eql b e)
  433.       (let ((buf (fred-buffer self)))
  434.         (buffer-delete buf b e)))))
  435.  
  436. (def-fred-command (:control #\delete) ed-delete-selection-silently)
  437.  
  438. ; Some simple editor mode handling stuff.
  439. (defun ed-enter-mode (w mode-name &rest bindings)
  440.   (let* ((buf (fred-buffer w))
  441.          (modes (buffer-getprop buf :modes))
  442.          (comtab (slot-value w 'comtab)))
  443.     (when (eq comtab *comtab*)
  444.       (setf (slot-value w 'comtab)
  445.             (setq comtab (copy-comtab comtab))))
  446.     (when (assq mode-name modes)
  447.       (ed-exit-mode w mode-name)
  448.       (setq modes (buffer-getprop buf :modes)))
  449.     (let ((old-bindings (insert-key-bindings comtab bindings)))
  450.       (buffer-putprop 
  451.        buf :modes
  452.        (cons (cons mode-name old-bindings) modes)))))
  453.  
  454. (defun insert-key-bindings (comtab bindings)
  455.   (let (old-bindings)
  456.     (loop
  457.       (unless bindings (return))
  458.       (let* ((key (pop bindings))
  459.              (function (pop bindings)))
  460.         (push key old-bindings)
  461.         (push (comtab-get-key comtab key) old-bindings)
  462.         (comtab-set-key comtab key function)))
  463.     (nreverse old-bindings)))
  464.  
  465. (defun ed-exit-mode (w mode-name)
  466.   (let* ((buf (fred-buffer w))
  467.          (modes (buffer-getprop buf :modes))
  468.          (this-mode (assq mode-name modes))
  469.          (comtab (slot-value w 'comtab))
  470.          later-modes)
  471.     (when this-mode
  472.       (loop
  473.         (let ((mode (pop modes)))
  474.           (when (eq mode this-mode)
  475.             (insert-key-bindings comtab (cdr mode))
  476.             (return))
  477.           (push (cons (car mode) (insert-key-bindings comtab (cdr mode)))
  478.                 later-modes)))
  479.       (dolist (mode later-modes)
  480.         (push (cons (car mode) (insert-key-bindings comtab (cdr mode)))
  481.               modes))
  482.       (buffer-putprop buf :modes modes))))
  483.  
  484. ; A mode that makes #\return & #\tab behave as they do in MPW
  485. (defun ed-mpw-mode (w)
  486.   (ed-enter-mode w :mpw
  487.                  #\return 'ed-return-and-indent-for-mpw
  488.                  #\tab 'ed-self-insert
  489.                  '(:meta :shift #\M) 'ed-end-mpw-mode)
  490.   (set-mini-buffer w "MPW mode."))
  491.  
  492. (defun ed-end-mpw-mode (w)
  493.   (ed-exit-mode w :mpw)
  494.   (set-mini-buffer w "End MPW mode."))
  495.  
  496. (defconstant *wsp* #.(coerce #(#\space #\tab) 'string))
  497.  
  498. (defun ed-return-and-indent-for-mpw (w)
  499.   (let* ((buf (fred-buffer w))
  500.          (start (buffer-line-start buf))
  501.          (end (buffer-forward-find-not-char buf *wsp* start buf)))
  502.     (if end
  503.       (decf end)
  504.       (setq end (buffer-position buf)))
  505.     (buffer-insert buf #\return)
  506.     (buffer-insert buf (buffer-substring buf start end))))
  507.  
  508. (comtab-set-key *comtab* '(:meta :shift #\m) 'ed-mpw-mode)
  509.             
  510.